home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol244 / multgled.bas < prev    next >
Encoding:
BASIC Source File  |  1986-12-01  |  7.7 KB  |  148 lines
  1. 10 GOTO 80
  2. 20 PRINT" Saving  ":SAVE"multgled":STOP  '   Aug 30  1986
  3. 30 '
  4. 40 ' By  GEORGE SKARBEK
  5. 50 '
  6. 60 '===================================================
  7. 70 '
  8. 80 KEY OFF:KEY 9,"SYSTEM" : DEFINT I-N
  9. 90 DIM WORDORG$(500),WORDREP$(500),RECORD$,J%,SL%,S$
  10. 100 DEF FN TRIM$( C$ ) = LEFT$( C$ + "  ", INSTR( C$ + "  ","  " ) - 1 )
  11. 110 DEF FN INSERT$(X$,Y$,NB)=LEFT$(X$,NB-1)+Y$+RIGHT$(X$,LEN(X$)-NB+1)
  12. 120 DEF FN REMOVE$(X$,START%,LENGTH%)=LEFT$(X$,START%-1)+RIGHT$(X$,LEN(X$)-(START%+LENGTH%)+1)
  13. 130 GOTO 240
  14. 140 '---------------------- Change record ----------------------------------+
  15. 150 J%=INSTR(RECORD$,S$)
  16. 160 IF LEN(RECORD$)+LEN(D$) >254 THEN BEEP: PRINT:PRINT" The following line is not fully converted ":COLOR 8,7: PRINT RECORD$ :COLOR 2,0:RETURN
  17. 170 TMP$ = FN REMOVE$(RECORD$,J%,SL%)
  18. 180 RECORD$ = FN INSERT$(TMP$,D$,J%)
  19. 190 COLOR 13:PRINT RECORD$:REPNO=REPNO+1:COLOR 3
  20. 200  IF J%+SL% > LEN(RECORD$) THEN RETURN
  21. 210  IF INSTR(J%+DL%,RECORD$,S$) >0 THEN J% = INSTR(J%+DL%,RECORD$,S$):GOTO 160
  22. 220 RETURN
  23. 230 '-----------------------------------------------------------------------+
  24. 240   CLS:LOCATE 1,1:COLOR 0,7:PRINT STRING$(240,32):LOCATE 2,22:COLOR 15,7:PRINT "GLOBAL EDITING OF DATASETS"
  25. 250  LOCATE 3,20:PRINT STRING$(30,205):COLOR 14,0:LOCATE 4,4:PRINT "Version 2.3":LOCATE 4,60:PRINT"By George Skarbek":COLOR 3,0:PRINT
  26. 260 PRINT" This program allows you to change ALL occurences of many strings to other      strings in ALL files ending with the same extension."
  27. 270 PRINT:PRINT"  Before starting this program you must have created TWO files,                                        called DIR.EDT and $KEYWORD.2"
  28. 280 PRINT"Creating DIR.EDT is done in DOS by typing ";:COLOR 11,0:PRINT" DIR>DIR.EDT or DIR *.etc >DIR.EDT ":COLOR 3
  29. 290 PRINT"Creating $KEYWORD.2 is done by using any editor and it must contain two words   per line, separated by a comma.":PRINT
  30. 300 PRINT" To have blanks in either the source or destination string, enclose that string with quotes - e.g. To replace FRED with    FRED   use the following input       FRED,"+CHR$(34)" FRED "+CHR$(34):PRINT:PRINT
  31. 310 PRINT:COLOR 11:PRINT" If the two above do not exist, then type Q for the Source drive.":PRINT:COLOR 3
  32. 320   INPUT "Source      drive   (eg.  C: ) ===> ";SOURCE$: IF SOURCE$="" THEN SOURCE$="C:" ELSE IF SOURCE$="Q" OR SOURCE$="q" THEN END
  33. 330 IF INSTR(SOURCE$,":") = 0 AND LEN(SOURCE$)= 1 THEN SOURCE$=SOURCE$+":"
  34. 340   INPUT "Destination drive   (eg.  D: ) ===> ";DEST$ :  IF DEST$="" THEN DEST$="D:"
  35. 350 TXT$=DEST$:GOSUB 1100 :DEST$=TXT$  ' Convert to UPPER case
  36. 360 TXT$=SOURCE$:GOSUB 1100 :SOURCE$=TXT$  ' Convert to UPPER case
  37. 370 IF INSTR(DEST$,":") = 0 AND LEN(DEST$)= 1 THEN DEST$=DEST$+":"
  38. 380   INPUT "Extension to edit   (eg.  BAS) ===> ";REXT$: IF REXT$="" THEN REXT$="BAS"
  39. 390 TXT$=REXT$:GOSUB 1100 :REXT$=TXT$  ' Convert to UPPER case
  40. 400 IF SOURCE$=DEST$ THEN INPUT "Enter new extension (eg.  ASC) ===> ";NREXT$: IF NREXT$="" THEN NREXT$="ASC"
  41. 410 TXT$=NREXT$:GOSUB 1100 :NREXT$=TXT$  ' Convert to UPPER case
  42. 420 IF SOURCE$=DEST$ THEN SAME=1
  43. 430 PRINT: PRINT "Do you wish to list All lines or only the Changed ones ( A or C* ) ";
  44. 440  Q$=INKEY$:IF Q$="" THEN 440  ELSE IF Q$="A" OR Q$="a" THEN ALL = 1
  45. 450   COLOR 10,0:  PRINT TAB(10) " Press Q to quit at any time ":PRINT:COLOR 2,0
  46. 460     ON ERROR GOTO 1210
  47. 470     OPEN "I", 1 , "$KEYWORD.2":GOSUB 1160
  48. 480       OPEN "I",1,SOURCE$+"DIR.EDT"
  49. 490        FOR J! = 1 TO 3
  50. 500           LINE INPUT #1,RECORD$
  51. 510        NEXT J!
  52. 520        NF% = 0
  53. 530 '
  54. 540 WHILE NOT EOF(1)
  55. 550 LINE INPUT #1,RECORD$ :IF LEN(RECORD$)<2 THEN 550
  56. 560  Q$=INKEY$:IF Q$="" THEN 570  ELSE IF Q$="Q" OR Q$="q" THEN 1050
  57. 570  GOSUB 900                                ' extract filename
  58. 580   IF OK%     = 0 THEN 860
  59. 590   IF IGNORE% = 1 THEN 860
  60. 600   IF MID$( FILENAME$,1,1 ) = "." THEN CLOSE:GOTO 9999
  61. 610 '
  62. 620   XXXXXX$ = SOURCE$+FILENAME$
  63. 630   YYYYYY$ = DEST$  +FILENAME$
  64. 640   IF SAME=1 THEN YYYYYY$ = NAM$+DOT$+NREXT$
  65. 650   ON ERROR GOTO 1070
  66. 660   OPEN XXXXXX$ FOR INPUT  AS #2
  67. 670   ON ERROR GOTO 1210
  68. 680    NF% = NF% + 1
  69. 690    OPEN YYYYYY$ FOR OUTPUT AS #3
  70. 700     HEADER$ = "                                                        "
  71. 710     MID$( HEADER$,1 ) =  XXXXXX$
  72. 720     MID$( HEADER$,18 ) = "to"
  73. 730     MID$( HEADER$,25 ) = YYYYYY$
  74. 740 PRINT:PRINT:COLOR 15,3: PRINT " Editing    ";HEADER$:COLOR 3,0
  75. 750 PRINT STRING$(90,32)
  76. 760     WHILE NOT EOF(2)
  77. 770        LINE INPUT #2,RECORD$
  78. 780        FOR L = 1 TO N : S$=WORDORG$(L) : D$=WORDREP$(L)
  79. 790          SL%=LEN(S$):DL%=LEN(D$)
  80. 800          IF INSTR(RECORD$,S$) > 0 THEN GOSUB 150
  81. 810        NEXT L
  82. 820    PRINT #3,RECORD$ :IF ALL=1 THEN COLOR 3,0:PRINT" Writing --> ";:COLOR 11,0:PRINT RECORD$:COLOR 3,0
  83. 825    Q$=INKEY$:IF Q$="" THEN 830  ELSE IF Q$="Q" OR Q$="q" THEN 1050
  84. 830     WEND
  85. 840  CLOSE 3 : CLOSE 2
  86. 850  Q$=INKEY$:IF Q$="" THEN 860  ELSE IF Q$="Q" OR Q$="q" THEN 1050
  87. 860 WEND
  88. 870 CLOSE 1
  89. 880 GOTO 1050
  90. 890 '-----------------------------------------------------------------------+
  91. 900 OK% = 1
  92. 910  X1$ = MID$( RECORD$,1,1 )
  93. 920  X2$ = MID$( RECORD$,1,2 )
  94. 930    IF X1$ = "." OR X2$ = ".." THEN 990
  95. 940 IF OK% = 0 THEN RETURN
  96. 950 NAM$ = LEFT$( RECORD$,8 )
  97. 960  DOT$ = "."
  98. 970  EXT$ = MID$( RECORD$,10,3 )
  99. 980    IF EXT$ < > REXT$ THEN IGNORE% = 1 ELSE IGNORE% = 0
  100. 990 NAM$ = FN TRIM$( NAM$ )
  101. 1000  FILENAME$ = NAM$ + DOT$ + EXT$
  102. 1010   IF FILENAME$ = "DIR.EDT" THEN OK%=0:RETURN
  103. 1020  RETURN
  104. 1030 '-----------------------------------------------------------------------+
  105. 1040 '
  106. 1050 PRINT:PRINT:PRINT TAB(15) "Number of files edited      = ";NF% :PRINT TAB(15) "Number of replacements made = "REPNO:PRINT: GOTO 9999
  107. 1060 '
  108. 1070 PRINT "Can't open ";FILENAME$,"execution continuing..":BEEP:RESUME 540
  109. 1080 PRINT "Can't open ";DEST$+FILENAME$,"execution continuing..":BEEP:RESUME 840
  110. 1090 '----------  Convert to UPPER case -------------
  111. 1100 FOR J%=1 TO LEN(TXT$)
  112. 1110 U$=MID$(TXT$,J%,1): IF ASC(U$) < 92 THEN GOTO 1130
  113. 1120 MID$(TXT$,J%,1)=CHR$(ASC(U$)-32)
  114. 1130 NEXT
  115. 1140 RETURN
  116. 1150 ' -----------  Read in all the key words ------------
  117. 1160 WHILE NOT EOF(1) : N=N+1
  118. 1170 INPUT #1, WORDORG$(N),WORDREP$(N)
  119. 1180 GOTO 1160
  120. 1190 WEND :CLOSE 1 : RETURN
  121. 1200 '------------------- Error trapping -------------
  122. 1210 COLOR 12,0:PRINT:BEEP
  123. 1220 IF ERR =53 AND ERL= 480 THEN PRINT:PRINT" The file DIR.EDT is not availble." : PRINT" You must create it first ":COLOR 2:PRINT:PRINT:STOP
  124. 1230 IF ERR =53 AND ERL= 470 THEN PRINT:PRINT" The file $KEYWORD.DAT is not availble." : PRINT"    You must create it first ":COLOR 2:PRINT:PRINT:STOP
  125. 1240 IF ERR=55  THEN PRINT :PRINT "FILE IS ALREADY OPEN - You must specify the source & destanation as sepatate disks":BEEP:GOTO 1300
  126. 1250 IF ERR=52  THEN PRINT :PRINT "BAD FILE NO.  ":BEEP:GOTO 1300
  127. 1260 IF ERR=61 THEN PRINT :PRINT "DISK IS FULL !":BEEP:GOTO 1300
  128. 1270 IF ERR=67 THEN PRINT :PRINT "FILE NAME ERROR": BEEP:GOTO  1300
  129. 1280 IF ERR = 70 THEN PRINT :PRINT "DISK WRITE PROTECTED":INPUT "TAKE THE WRITE PROTECT OFF AND PRESS <RETURN> TO CONTINUE ";QQ$:RESUME
  130. 1290 PRINT:PRINT:PRINT: PRINT "ERROR "; ERR; "IN LINE "; ERL ; "CONSULT MANUAL"
  131. 1300 PRINT:PRINT:COLOR 2,0:STOP
  132. 9999 PRINT:PRINT" Touch any key to continue ";
  133. 10000 A$=INKEY$:IF A$="" THEN 10000
  134. 10001 COLOR 15,7 :CLS
  135. 10005 LOCATE  5 ,2
  136. 10010 PRINT" If this program has been of use to you,";
  137. 10020 PRINT"  please send $10 to:-
  138. 10030 PRINT"
  139. 10040 PRINT"                        George Skarbek
  140. 10050 PRINT"                         2 Tiuna Court
  141. 10060 PRINT"                         Glen Waverley
  142. 10070 PRINT"                         Victoria 3150
  143. 10080 PRINT"                           Australia
  144. 10090 PRINT"
  145. 10100 LOCATE 15 ,2:PRINT " If not, then give it to a friend who may have need it."
  146. 10110 LOCATE 24 ,1:COLOR 3,0
  147. 10120 END
  148.